home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / gus / vts139b.zip / PLAYMOD.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-22  |  52KB  |  1,561 lines
  1. {****************************************************************************}
  2. {                                                                            }
  3. { MODULE:         PlayMod                                                    }
  4. {                                                                            }
  5. { DESCRIPTION:    This UNIT allows to play a music module (*.MOD) in any     }
  6. {                 device supported in the SoundDevices sound system.         }
  7. {                                                                            }
  8. {                 Entrys:   PlayMod To begin playing the MOD.                }
  9. {                           StopMod To stop playing the MOD.                 }
  10. {                                                                            }
  11. { AUTHOR:         Juan Carlos Arévalo                                        }
  12. {                 Luis Crespo (parts extracted from the JAMP 1.5 MOD Player) }
  13. {                                                                            }
  14. { MODIFICATIONS:  Nobody (yet... ;-)                                         }
  15. {                                                                            }
  16. { HISTORY:        22-Jun-1992 Begins to use the SoundDevices sound system.   }
  17. {                             Internal cleaning, which was quite needed.     }
  18. {                             UnCanal routine made even faster.              }
  19. {                 11-Nov-1992 Redocumentation. There have been really many   }
  20. {                             enhancements since June, but they weren't      }
  21. {                             documented. Mainly more speed-ups.             }
  22. {                 24-Jan-1993 Added 8 voice support.                         }
  23. {                                                                            }
  24. {                                                                            }
  25. { (C) 1992 VangeliSTeam                                                      }
  26. {____________________________________________________________________________}
  27.  
  28. UNIT PlayMod;
  29.  
  30. INTERFACE
  31.  
  32. USES SongUnit, SongUtils, SongElements, ModCommands, SoundDevices, Filters, Kbd;
  33.  
  34.  
  35.  
  36.  
  37. { Definitions. }
  38.  
  39. TYPE
  40.   TTickProc = PROCEDURE(VAR Song: TSong; note: BOOLEAN); { Procedure to execute every tick. }
  41.   TVolumes  = ARRAY[1..MaxChannels] OF BYTE;             { Volume set (all channels). }
  42.  
  43.  
  44.  
  45.  
  46. { General definitions about the way of playing the music. }
  47. { Music player configuration.                             }
  48.  
  49. CONST
  50.   PlayingSong        : PSong         = NIL;
  51.   LoopMod            : BOOLEAN       = TRUE;   { TRUE if music can be played forever.                  }
  52.   ForceLoopMod       : BOOLEAN       = FALSE;  { TRUE if music must be played forever.                 }
  53.   CanFallBack        : BOOLEAN       = TRUE;   { TRUE if fall-back is allowed.                         }
  54.   FilterOn           : TFilterMethod = fmNone; { Initial value of the ON  filter.                      }
  55.   FilterOff          : TFilterMethod = fmNone; { Initial value of the OFF filter.                      }
  56.   FilterIsOn         : BOOLEAN       = FALSE;  { Initial position of the filter (FALSE = OFF).         }
  57.   MaxOutputFreq      : WORD          = 45000;  { Maximum frequency of the output sound.                }
  58.                                                { Less means less memory for buffers.                   }
  59.   DontExecute        : BOOLEAN       = FALSE;
  60.  
  61.  
  62. VAR
  63.   SplBuf             : ARRAY[1..MaxChannels] OF WORD;
  64.  
  65.                                                              
  66. { Exported variables. }
  67.  
  68. CONST
  69.   Playing          : BOOLEAN = FALSE;       { (Read only) TRUE if the music is sounding right now.     }
  70.   ModTickProcValid : BOOLEAN = FALSE;       { TRUE if the module tick procedure has been initialised.  }
  71.  
  72. VAR
  73.   ActualHz        : WORD;                   { Desired freq. of the sound.                              }
  74.   NoteHz          : WORD;                   { Freq. to be used in the current tick.                    }
  75.   NoteCalcVal     : LONGINT;
  76.   UserVols        : TVolumes;               { Channel volumes.                                         }
  77.   Permisos        : ARRAY[1..MaxChannels] OF BOOLEAN; { Permissions for playing the channels.          }
  78.   TickCount       : WORD;                   { Ticks counter. Increments each tick.                     }
  79.   ModTickProc     : TTickProc;              { Tick procedure. A procedure to be executed every tick.   }
  80.   MyCanFallBack   : BOOLEAN;                { Actual permission to fall-back.                          }
  81.   FilterVal       : TFilterMethod;          { Method of the filter to be used.                         }
  82.                                                              
  83.  
  84. { Definition of the local stack. }
  85.  
  86. CONST
  87.   PlayModStackSize = 500;   { Size of the stack. }
  88.  
  89. VAR
  90.   PlayModStack     : ARRAY[1..PlayModStackSize] OF BYTE;     
  91.  
  92.  
  93. { Definitions concerning a note. Buffer of the last N notes. }
  94.  
  95. TYPE
  96.   PPlayingNote = ^TPlayingNote;
  97.   TPlayingNote = RECORD
  98.     EoMod       : BOOLEAN;                 { TRUE if it is the note following the last.                }
  99.     Tempo       : BYTE;                    { Number of ticks the note will last.                       }
  100.     NotePlaying : BYTE;                    { Index of the note inside the pattern.                     }
  101.     SeqPlaying  : BYTE;                    { Sequence number of the pattern to which the note belongs. }
  102.     Volume      : TVolumes;                { Volumes of the channels.                                  }
  103.     Note        : ARRAY[1..MaxChannels] OF TFullNote; { Notes of the channels.                       }
  104.     NMuestras   : WORD;                    { Number of samples processed for each note.                }
  105.     fill        : BYTE;                    { To make it a 32-byte record.                              }
  106.   END;
  107.  
  108. CONST
  109.   NoteBuffSize = 1;   { Number of note buffers. }
  110.  
  111. VAR
  112.   NoteBuff      : ARRAY[0..NoteBuffSize-1] OF TPlayingNote;
  113.  
  114. CONST
  115.   NoteTl        : WORD = 0;
  116.   NoteHd        : WORD = 0;
  117.  
  118.   NoteSound     : PPlayingNote = NIL;
  119.   NoteProcessed : PPlayingNote = NIL;
  120.  
  121. VAR
  122.   Canales : ARRAY[1..MaxChannels] OF TCanal; { State of the channels. }
  123.  
  124.  
  125.  
  126.  
  127. {----------------------------------------------------------------------------}
  128. { Definition of the buffers where the samples are placed.                    }
  129. {____________________________________________________________________________}
  130.  
  131. CONST
  132.   MaxSplPerTick : WORD = 880; { Maximum samples in the buffer. Means maximum samples per tick. }
  133.   NumBuffers           = 3;   { Number of buffers.                                             }
  134.  
  135. VAR
  136.   BuffIdx,         { Tail of the buffer. }
  137.   BuffGive : WORD; { Head of the buffer. }
  138.  
  139.   Buffers       : ARRAY[1..NumBuffers] OF TSampleBuffer;
  140.   SizeOfABuffer : WORD;
  141.  
  142.  
  143.  
  144. {----------------------------------------------------------------------------}
  145. { Exported procedures.                                                       }
  146. {____________________________________________________________________________}
  147.  
  148. PROCEDURE PlayStart(VAR Song: TSong);
  149. PROCEDURE PlayStop;
  150.  
  151. PROCEDURE ChangeSamplingRate(Hz: WORD);
  152. PROCEDURE ProcessTickEntry;
  153. PROCEDURE FillWithSamples   (VAR Buff; Size: WORD);
  154.  
  155.  
  156.  
  157.  
  158. IMPLEMENTATION
  159.  
  160. USES Dos,
  161.      Heaps,
  162.      Output43,
  163.      GUS,
  164.      HexConversions,
  165.      Debugging;
  166.  
  167.  
  168.  
  169.  
  170. {----------------------------------------------------------------------------}
  171. { General definitions of the module player. They define its actual state.    }
  172. {____________________________________________________________________________}
  173.  
  174. VAR
  175.   DelaySamples    : BOOLEAN;     { TRUE means it couldn't fill the samples buffer.                }
  176.   MuestrasPerTick : WORD;        { Number of samples that there are in a tick at the actual freq. }
  177.  
  178.  
  179.  
  180. {----------------------------------------------------------------------------}
  181. { Raw channel definitions.                                                   }
  182. {____________________________________________________________________________}
  183.  
  184. TYPE
  185.   PModRawChan = ^TModRawChan;
  186.   TModRawChan = RECORD
  187.     Flags      : BYTE;         { Channel flags (see below).                 }
  188.  
  189.     SplPosFrac : WORD;         { Position fraction.                         }
  190.     SplPosInt  : WORD;         { Position offset.                           }
  191.     SplPosSeg  : WORD;         { Position segment.                          }
  192.                                
  193.     SplOfs     : WORD;         { Actual sample part offset.                 }
  194.     SplSeg     : WORD;         { Actual sample part segment.                }
  195.     SplLimit   : WORD;         { Actual sample part size.                   }
  196.  
  197.     SplOfs1    : WORD;         { First  sample part offset.                 }
  198.     SplSeg1    : WORD;         { First  sample part segment.                }
  199.     SplLimit1  : WORD;         { First  sample part size.                   }
  200.  
  201.     SplOfs2    : WORD;         { Second sample part offset.                 }
  202.     SplSeg2    : WORD;         { Second sample part segment.                }
  203.     SplLimit2  : WORD;         { Second sample part size.                   }
  204.  
  205.     StepFrac   : WORD;         { Sample incement fraction.                  }
  206.     StepInt    : WORD;         { Sample incement integer.                   }
  207.  
  208.     Volume     : BYTE;         { Volume to be used.                         }
  209.  
  210.     LoopEnd    : WORD;         { Offset of the end of the loop in its part. }
  211.     LoopLen    : WORD;         { Size of the loop in its part.              }
  212.   END;
  213.  
  214. CONST                      { TModRawChan.Flags }
  215.   rcfLongSample     = $01; { Set if it's a long (more than 65520 bytes) sample.     }
  216.   rcfActiveChannel  = $02; { Set if the channel is activated (permission to sound). }
  217.   rcfDoesLoop       = $04; { Set of the sample has a loop.                          }
  218.   rcfPlaying2nd     = $08; { Set if playing the 2nd part of the long loop.          }
  219.   rcfLongLoopLen    = $10; { Loop size goes from the 2nd part to the 1st.           }
  220.   rcfLongLoopEnd    = $20; { Loop ends in the 2nd part.                             }
  221.   rcfSampleFinished = $40; { Set if the sample has already finished.                }
  222.  
  223. VAR                                                 { Raw channels. }
  224.   RawChannels : ARRAY[1..MaxChannels] OF TModRawChan;
  225.  
  226.  
  227.  
  228.  
  229. {----------------------------------------------------------------------------}
  230. { Basic, fast assembler routines.                                            }
  231. {____________________________________________________________________________}
  232.  
  233.  
  234.  
  235. {$L PLAYMOD}
  236.  
  237. (*
  238. FUNCTION DumpInstrument( VAR {FPointer} Src; VAR Dest: POINTER; Volume: BYTE;
  239.                          Step: LONGINT; NumSrc, Max, ChanAdd: WORD; Empty: BOOLEAN)
  240.                          : WORD; EXTERNAL;
  241. *)
  242.  
  243. FUNCTION DumpInstrument(VAR {Pointer} Src; VAR {Pointer} Dest; Volume: BYTE;
  244.                         Step: WORD; SrcLimit, Max, ChanAdd: WORD) : WORD; FAR; EXTERNAL;
  245.  
  246. FUNCTION DumpEmpty     (VAR {Pointer} Src; VAR {Pointer} Dest; Volume: BYTE;
  247.                         Step: WORD; SrcLimit, Max, ChanAdd: WORD) : WORD; FAR; EXTERNAL;
  248.  
  249. PROCEDURE UnCanal(VAR Raw: TModRawChan; VAR Buf: POINTER);
  250.   CONST
  251.     Rest : WORD = 0;
  252.   BEGIN
  253.  
  254.     Rest := MuestrasPerTick;
  255.  
  256.     IF ((Raw.Flags  AND rcfActiveChannel)  <> 0) AND
  257.        ((Raw.Flags  AND rcfSampleFinished) =  0) {AND
  258.        ( Raw.Volume                        <> 0) }{AND FALSE} THEN
  259.       BEGIN
  260.         IF (Raw.Flags AND rcfDoesLoop) <> 0 THEN
  261.           WHILE Rest <> 0 DO
  262.             BEGIN
  263.               Rest := DumpInstrument( Raw.SplPosFrac, Buf, Raw.Volume,
  264.                                       (Raw.StepFrac SHR 4) + (Raw.StepInt SHL 12){*65536},
  265.                                       Raw.LoopEnd, Rest,
  266.                                       NumChannels*2);
  267.               IF Rest <> 0 THEN
  268.                 DEC(Raw.SplPosInt, Raw.LoopLen);
  269.             END
  270.         ELSE
  271.           Rest := DumpInstrument( Raw.SplPosFrac, Buf, Raw.Volume,
  272.                                   (Raw.StepFrac SHR 4) + (Raw.StepInt SHL 12){*65536},
  273.                                   Raw.SplLimit, Rest,
  274.                                   NumChannels*2);
  275.  
  276.       END;
  277.  
  278.     IF Rest > 0 THEN
  279.       BEGIN
  280.         IF (Raw.Flags AND rcfSampleFinished) = 0 THEN
  281.           Rest := DumpEmpty     ( Raw.SplPosFrac, Buf, 0,
  282.                                   (Raw.StepFrac SHR 4) + (Raw.StepInt SHL 12){*65536},
  283.                                   Raw.SplLimit, Rest,
  284.                                   NumChannels*2)
  285.         ELSE
  286.           Rest := DumpEmpty     ( Raw.SplPosFrac, Buf, 0,
  287.                                   0,
  288.                                   Raw.SplLimit, Rest,
  289.                                   NumChannels*2);
  290.         Raw.Flags := Raw.Flags OR rcfSampleFinished;
  291.       END;
  292.  
  293.   END;
  294.  
  295.  
  296.  
  297.  
  298.  
  299. (*
  300. {----------------------------------------------------------------------------}
  301. {                                                                            }
  302. { ROUTINE: UnCanal                                                           }
  303. {                                                                            }
  304. { Fills a buffer with 8 bit samples, calculated from a sample, a freq. and   }
  305. { a volume (a RawChannel).                                                   }
  306. { Implemented as several specialised routines, for speed's sake.             }
  307. { It doesn't play long samples yet.                                          }
  308. { This routine self-modifies, for speed's sake.                              }
  309. {                                                                            }
  310. { IN:       CX    = Number of samples.                                       }
  311. {           BX    = Offset of the channel data (TModRawChan).                }
  312. {           DI    = Offset of the buffer to be filled.                       }
  313. {                                                                            }
  314. { OUT:      The buffer will have been filled.                                }
  315. {                                                                            }
  316. { MODIFIES: Every register except DS.                                        }
  317. {                                                                            }
  318. {............................................................................}
  319.  
  320. PROCEDURE UnCanal; ASSEMBLER;
  321.   ASM
  322.         MOV     AX,[SoundDevices.NumChannels]
  323.         ADD     AX,AX
  324.         MOV     WORD PTR [CS:@@dlData1-2],AX
  325.         MOV     WORD PTR [CS:@@nlData1-2],AX
  326.         MOV     WORD PTR [CS:@@Data1  -2],AX
  327.  
  328.  
  329.         TEST    [TModRawChan(DS:BX).Flags],rcfActiveChannel  { ¿Active channel? }
  330.         JZ      @@Desactivado                                { If not -> do the silent loop }
  331.  
  332.         TEST    [TModRawChan(DS:BX).Flags],rcfSampleFinished { ¿Already finished? }
  333.         JNZ     @@Desactivado                                { If it is -> do the silent loop }
  334.  
  335.         TEST    BYTE PTR [TModRawChan(DS:BX).Volume],$FF     { Volumen }
  336.         JZ      @@Desactivado
  337.  
  338.         PUSH    BX                                           { BX is saved for restoring data at the end }
  339.  
  340.         TEST    [TModRawChan(DS:BX).Flags],rcfDoesLoop       { ¿Does the sample have a loop? }
  341.         JZ      @@NoDoesLoop                                 { If not -> do the loop-less routine }
  342.  
  343. {
  344.  
  345.   Sample with a loop (it doesn't check the end of the sample).
  346.  
  347. }
  348.  
  349.         MOV     AX,[TModRawChan(DS:BX).LoopEnd]              
  350.         MOV     WORD PTR [CS:@@dlData2-2],AX                 { Puts the loop-end OFFSET in its instruction }
  351.  
  352.         MOV     AX,[TModRawChan(DS:BX).LoopLen]              
  353.         MOV     WORD PTR [CS:@@dlData3-2],AX                 { Puts the loop-size in its instruction }
  354.  
  355.         MOV     DL,BYTE PTR [TModRawChan(DS:BX).Volume]      { Volume }
  356.         MOV     AL,[TModRawChan(DS:BX).StepFrac]             { Increment fraction }
  357.         MOV     BP,[TModRawChan(DS:BX).StepInt]              { Increment integer  }
  358.  
  359.         MOV     AH,[TModRawChan(DS:BX).SplPosFrac]           { Position OFFSET }
  360.  
  361.         LDS     SI,DWORD PTR [TModRawChan(DS:BX).SplPosInt]  { Pointer to the next sample to be read }
  362.  
  363.         MOV     BX,AX   { ¡¡¡No tocar!!! (BX es el puntero al buffer) }
  364. {
  365.  
  366.       Bucle. Se entra con:
  367.         DL = Volumen
  368.         BL = Parte fraccionaria del incremento.
  369.         BP = Parte entera del incremento.
  370.         BH = Parte fraccionaria de la posición en el sample.
  371.         SI = Parte entera de la posición en el sample.
  372.         ES = Segmento del buffer.
  373.         DS = Segmento del sample.
  374.         DI = Buffer donde se almacenan las muestras.
  375.         CX = Número total de muestras a generar.
  376.  
  377. }
  378.  
  379. @@dlLoop:
  380.         MOV     AL,[SI]                                      { Leo la muestra correspondiente }
  381.         IMUL    DL                                           { Multiplico por el volumen }
  382.         MOV     [ES:DI],AX                                   { Lo meto en el buffer (Instrucción automodificada) }
  383.         ADD     DI,$1234
  384. @@dlData1:
  385.  
  386.         ADD     BH,BL                                        { Añade el incremento fraccionario }
  387.         ADC     SI,BP                                        { Añade el incremento entero }
  388.         JC      @@dlSplLoop                                  { Carry -> Ha pasado el límite, seguro }
  389.                                                              { (máximo nº de muestras = 65520) }
  390. @@dlChkLoop:
  391.         CMP     SI,$1234                                     { CMP BP,[TModRawChan(DS:BX).LoopEnd] }
  392. @@dlData2:                                                   { ¿He llegado al pto. de retorno del loop? }
  393.         JB      @@dlNoLoop
  394.  
  395. @@dlSplLoop:
  396.         SUB     SI,$1234                                     { SUB BP,[TModRawChan(DS:BX).LoopLen] }
  397. @@dlData3:                                                   { Si es así, vuelvo para atrás. Esto es muy importante hacerlo }
  398.                                                              { restando el tamaño del bucle, y conservando la parte frac. }
  399.  
  400. @@dlNoLoop:
  401.         LOOP    @@dlLoop                                     { Y fin del bucle }
  402.  
  403.         JMP     @@Finish                                     { Salta al final, donde se almacenan los valores de por donde }
  404.                                                              { han quedado los punteros y demás }
  405.  
  406. {
  407.  
  408.   Sample sin loop (no comprueba el fin de loop).
  409.   Filosofía igual al anterior.
  410.  
  411. }
  412.  
  413. @@NoDoesLoop:
  414.  
  415.         MOV     AX,[TModRawChan(DS:BX).SplLimit]             { Pone el OFFSET del fin del sample en la instrucción }
  416.         MOV     WORD PTR [CS:@@nlData2-2],AX
  417.  
  418.         MOV     DL,BYTE PTR [TModRawChan(DS:BX).Volume]      { Volumen }
  419.         MOV     AL,[TModRawChan(DS:BX).StepFrac]             { Parte fraccionaria del incremento }
  420.         MOV     AH,[TModRawChan(DS:BX).SplPosFrac]           { Parte fraccionaria del OFFSET del puntero a la muestra }
  421.  
  422.         MOV     BP,[TModRawChan(DS:BX).StepInt]              { Parte entera del incremento }
  423.  
  424.         LDS     SI,DWORD PTR [TModRawChan(DS:BX).SplPosInt]  { Puntero a la próxima muestra a leer }
  425.  
  426.         MOV     BX,AX   { ¡¡¡No tocar!!! (BX es el puntero al buffer) }
  427.  
  428. {
  429.  
  430.       Bucle. Se entra con:
  431.         DL = Volumen
  432.         BL = Parte fraccionaria del incremento.
  433.         BP = Parte entera del incremento.
  434.         BH = Parte fraccionaria de la posición en el sample.
  435.         SI = Parte entera de la posición en el sample.
  436.         ES = Segmento del buffer.
  437.         DS = Segmento del sample.
  438.         DI = Buffer donde se almacenan las muestras.
  439.         CX = Número total de muestras a generar.
  440.  
  441. }
  442.  
  443. @@nlLoop:
  444.         MOV     AL,[SI]                                      { Leo la muestra correspondiente }
  445.         IMUL    DL                                           { Multiplico por el volumen }
  446.         MOV     [ES:DI],AX                                   { Lo meto en el buffer }
  447.         ADD     DI,$1234
  448. @@nlData1:
  449.  
  450.         ADD     BH,BL                                        { Añade el incremento fraccionario }
  451.         ADC     SI,BP                                        { Añade el incremento entero }
  452.         JC      @@nlSeguroFin                                { Carry -> Ha pasado el límite del sample, seguro }
  453.                                                              { (máximo nº de muestras = 65520) }
  454.  
  455.         CMP     SI,$1234                                     { CMP BP,[TModRawChan(DS:BX).SplLimit] }
  456. @@nlData2:                                                   { ¿He llegado al final del sample? }
  457.         JNB     @@nlSeguroFin                                { Si es así, dejo de calcular }
  458.  
  459. @@nlNoLoop:
  460.         LOOP    @@nlLoop                                     { Y fin del bucle }
  461.  
  462.         JMP     @@Finish                                     { Salta al final, donde se almacenan los valores de por donde }
  463.                                                              { han quedado los punteros y demás }
  464.  
  465. @@nlSeguroFin:                                               { Se ha terminado el sample }
  466.         MOV     BX,SEG @Data                                 { Reinicializamos DS }
  467.         MOV     DS,BX
  468.         POP     BX                                           { Recupera el TModRawChan en BX }
  469.         OR      BYTE PTR [TModRawChan(DS:BX).Flags],rcfSampleFinished                { Desactivo el canal }
  470.         DEC     CX                                           { Decrementa el número de muestras, no se ha podido hacer antes }
  471.         JCXZ    @@Fin                                        { Si ya no hay más -> bye }
  472.  
  473. {
  474.  
  475.   Bucle correspondiente a un sample vacío. No se puede eliminar
  476.   porque tiene que, por lo menos, poner el buffer a cero.
  477.  
  478. }
  479.  
  480. @@Desactivado:
  481.         XOR     AX,AX                                        { Todas las muestras a cero }
  482. @@Data2:
  483.         MOV     [ES:DI],AX                                   { Le meto el cero en el buffer }
  484.         ADD     DI,$1234
  485. @@Data1:
  486.         LOOP    @@Data2                                      { Fin del bucle }
  487.  
  488.         JMP     @@Fin                                        { Y me vuelvo sin restaurar nada }
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  
  495.  
  496. @@Finish:
  497.         MOV     BP,SEG @Data                                 { Reinicializamos DS }
  498.         MOV     DS,BP
  499.         POP     BP                                           { Recupero el TModRawChan }
  500.         MOV     [TModRawChan(DS:BP).SplPosInt],SI            { Y guardo el OFFSET del sample donde se ha quedado }
  501.         MOV     [TModRawChan(DS:BP).SplPosFrac],BH
  502.  
  503. @@Fin:
  504.         MOV     AX,SEG @Data                                 { Reinicializamos DS }
  505.         MOV     DS,AX
  506.   END;
  507. *)
  508.  
  509.  
  510.  
  511.  
  512. {----------------------------------------------------------------------------}
  513. { Rutinas que se dedican a interpretar la partitura.                         }
  514. {____________________________________________________________________________}
  515.  
  516.  
  517.  
  518.  
  519. {----------------------------------------------------------------------------}
  520. {                                                                            }
  521. { RUTINA: SetNewSample                                                       }
  522. {                                                                            }
  523. { Inicializa un nuevo sample en uno de los canales.                          }
  524. {                                                                            }
  525. { ENTRADAS: Raw : TModRawChan correspondiente al canal.                      }
  526. {           Spl : TSample correspondinte al canal.                           }
  527. {                                                                            }
  528. { SALIDAS:  Ninguna.                                                         }
  529. {                                                                            }
  530. {............................................................................}
  531.  
  532. PROCEDURE SetNewSample(i: BYTE; VAR Raw: TModRawChan; Spl: PInstrumentRec; Offs: WORD);
  533.   CONST
  534.     _or : BYTE    = 0;
  535.     f   : BOOLEAN = FALSE;
  536.   BEGIN
  537. {    FillChar(Raw, SizeOf(Raw), 0);}
  538.  
  539.     IF Spl = NIL THEN EXIT;
  540.  
  541.     ASM
  542.  
  543.         MOV     DI,WORD PTR Raw
  544.         LES     SI,Spl
  545.  
  546.         MOV     AX,WORD PTR TInstrumentRec([ES:SI]).data
  547.         MOV     TModRawChan([DI]).SplOfs1,AX
  548.         MOV     AX,WORD PTR TInstrumentRec([ES:SI+2]).data
  549.         MOV     TModRawChan([DI]).SplSeg1,AX                              { Inicializa los valores mínimos }
  550.         MOV     _or,rcfActiveChannel
  551.  
  552.         MOV     AX,WORD PTR TInstrumentRec([ES:SI+1]).repl
  553.         AND     AX,AX
  554.         JNZ     @@1
  555.          MOV    AL,BYTE PTR TInstrumentRec([ES:SI]).repl
  556.          CMP    AL,4
  557.          JNB    @@1
  558.          MOV    f,1
  559.          JMP    @@2
  560. @@1:    MOV     f,0                                     { Si tiene loop (no sé si es buena la comprobación }
  561.         OR      _or,rcfDoesLoop
  562. @@2:
  563.  
  564.       END;
  565.  
  566. (*
  567.     Raw.SplOfs1   := OFS(Spl^.data^);
  568.     Raw.SplSeg1   := SEG(Spl^.data^);                                      { Inicializa los valores mínimos }
  569.     _or           := rcfActiveChannel;
  570.  
  571.     f := Spl^.repl <= 4;
  572.     IF NOT f THEN INC(_or, rcfDoesLoop);                { Si tiene loop (no sé si es buena la comprobación }
  573. *)
  574.  
  575.     IF Spl^.len > MaxSample THEN BEGIN
  576.  
  577.       ASM
  578.  
  579.         MOV     DI,WORD PTR Raw                  { Entra aquí si es un sample largo (mayor de 65520 bytes) }
  580.         LES     SI,Spl
  581.  
  582.         OR      _or,rcfLongSample
  583.         MOV     TModRawChan([DI]).SplLimit1,MaxSample
  584.  
  585.       END;
  586.  
  587. (*
  588.       INC(_or, rcfLongSample);                   { Entra aquí si es un sample largo (mayor de 65520 bytes) }
  589.  
  590.       Raw.SplLimit1 := MaxSample;
  591. *)
  592.       Raw.SplLimit2 := Spl^.len - MaxSample;                      { Inicializa valores para el sample largo }
  593.       Raw.SplOfs2   := OFS(Spl^.xtra^);
  594.       Raw.SplSeg2   := SEG(Spl^.xtra^);
  595.  
  596.       IF NOT f THEN BEGIN                                                   { Si hay loop, pequeño lío :-) }
  597.         IF (Spl^.reps > MaxSample) OR (Spl^.reps+Spl^.repl <= MaxSample) THEN
  598.           Raw.LoopLen := Spl^.repl
  599.         ELSE BEGIN
  600.           Raw.LoopLen := Spl^.repl - MaxSample;
  601.           INC(_or, rcfLongLoopLen);
  602.         END;
  603.         IF Spl^.reps+Spl^.repl <= MaxSample THEN
  604.           Raw.LoopEnd := Spl^.reps + Spl^.repl
  605.         ELSE BEGIN
  606.           Raw.LoopEnd := Spl^.reps + Spl^.repl - MaxSample;
  607.           INC(_or, rcfLongLoopEnd);
  608.         END;
  609.       END;
  610.     END ELSE BEGIN
  611.  
  612.       ASM
  613.  
  614.         MOV     DI,WORD PTR Raw                { Entra aquí si es un sample pequeño (menor de 65520 bytes) }
  615.         LES     SI,Spl
  616.  
  617.         MOV     AX,WORD PTR TInstrumentRec([ES:SI]).len
  618.         MOV     TModRawChan([DI]).SplLimit1,AX
  619.  
  620.         MOV     AL,f
  621.         AND     AL,AL
  622.         JNZ     @@1
  623.          MOV    AX,WORD PTR TInstrumentRec([ES:SI]).repl
  624.          MOV    TModRawChan([DI]).LoopLen,AX
  625.          ADD    AX,WORD PTR TInstrumentRec([ES:SI]).reps
  626.          MOV    TModRawChan([DI]).LoopEnd,AX
  627. {         MOV    TModRawChan([DI]).SplLimit1,AX}
  628. @@1:
  629.  
  630.       END;
  631.  
  632. (*
  633.       Raw.SplLimit1 := Spl^.len;                { Entra aquí si es un sample pequeño (menor de 65520 bytes) }
  634.  
  635.       IF NOT f THEN BEGIN                                                                    { Si hay loop }
  636.         Raw.LoopEnd := Spl^.reps + Spl^.repl;
  637.         Raw.LoopLen := Spl^.repl;
  638.       END;
  639. *)
  640.     END;
  641.  
  642.     ASM
  643.  
  644.         MOV     DI,WORD PTR Raw                
  645.  
  646.         MOV     TModRawChan([DI]).SplPosFrac,0
  647.  
  648.         MOV     AX,TModRawChan([DI]).SplOfs1
  649.         MOV     TModRawChan([DI]).SplPosInt,AX
  650.         MOV     TModRawChan([DI]).SplOfs,AX
  651.  
  652.         MOV     AX,TModRawChan([DI]).SplSeg1
  653.         MOV     TModRawChan([DI]).SplPosSeg,AX
  654.         MOV     TModRawChan([DI]).SplSeg,AX
  655.  
  656.         MOV     AX,TModRawChan([DI]).LoopEnd
  657.         ADD     AX,TModRawChan([DI]).SplOfs1
  658.         MOV     TModRawChan([DI]).LoopEnd,AX
  659.  
  660.         MOV     AX,TModRawChan([DI]).SplLimit2
  661.         ADD     AX,TModRawChan([DI]).SplOfs2
  662.         MOV     TModRawChan([DI]).SplLimit2,AX
  663.  
  664.         MOV     AX,TModRawChan([DI]).SplLimit1
  665.         ADD     AX,TModRawChan([DI]).SplOfs1
  666.         MOV     TModRawChan([DI]).SplLimit1,AX
  667.         MOV     TModRawChan([DI]).SplLimit,AX
  668.  
  669.         MOV     AL,_or
  670.         MOV     TModRawChan([DI]).Flags,AL
  671.  
  672.     END;
  673. (*
  674.     Raw.SplPosFrac := 0;
  675.     Raw.SplPosInt  := Raw.SplOfs1;
  676.     Raw.SplPosSeg  := Raw.SplSeg1;
  677.  
  678.     Raw.SplOfs   := Raw.SplOfs1;
  679.     Raw.SplSeg   := Raw.SplSeg1;
  680.     Raw.SplLimit := Raw.SplLimit1;
  681.  
  682.     Raw.Flags  := _or;
  683. *)
  684.     IF UsingGUS THEN
  685.       IF (Raw.Flags AND rcfDoesLoop) <> 0 THEN
  686.         TriggerVoice(i-1, $FF, $FFFFFFFF, PlayingSong^.PanPositions[i],
  687.                      LONGINT(Spl^.Data) + Offs,
  688.                      LONGINT(Spl^.Data) + Spl^.Reps,
  689.                      LONGINT(Spl^.Data) + Spl^.Reps + Spl^.Repl)
  690.       ELSE
  691.         TriggerVoice(i-1, $FF, $FFFFFFFF, PlayingSong^.PanPositions[i],
  692.                      LONGINT(Spl^.Data) + Offs, -1,
  693.                      LONGINT(Spl^.Data) + Spl^.Len);
  694.  
  695.   END;
  696.  
  697.  
  698.  
  699.  
  700.  
  701. PROCEDURE MyMove(VAR Src, Dest; Bytes: WORD); ASSEMBLER;
  702.   ASM
  703.                 PUSH    DS
  704.  
  705.                 LDS     SI,[Src]
  706.                 LES     DI,[Dest]
  707.                 MOV     CX,[Bytes]
  708.  
  709.                 CLD
  710.  
  711.                 AND     CX,CX
  712.                 JZ      @@Fin
  713.  
  714.                 TEST    SI,1
  715.                 JZ      @@nobeg
  716.                  MOVSB
  717.                  DEC    CX
  718.                  JZ     @@Fin
  719.  
  720. @@nobeg:        MOV     BX,CX
  721.                 SHR     CX,1
  722.                 REP MOVSW
  723.                 MOV     CX,BX
  724.                 AND     CL,1
  725.                 JZ      @@Fin
  726.  
  727.                 MOVSB
  728. @@Fin:
  729.                 POP     DS
  730.   END;
  731.  
  732.  
  733.  
  734.  
  735. PROCEDURE ConvertPeriod(VAR v: WORD);
  736.   CONST
  737. {
  738.     NoteTable : ARRAY[0..11] OF WORD = ( $D600,$C9FD,$BEA7,$B3F4,
  739.                                          $A9DA,$A052,$9752,$8ED4,
  740.                                          $86D0,$7F3F,$781A,$715D );
  741.     NoteTableF: ARRAY[0..11] OF WORD = ( $D600,$C9FD,$BEA7,$B3F4,
  742.                                          $A9DA,$A052,$9752,$8ED4,
  743.                                          $86D0,$7F3F,$781A,$715D );
  744. }
  745.     NoteTable : ARRAY[0..11] OF WORD = ( $D600,$CA00,$BE80,$B400,
  746.                                          $A980,$A000,$9700,$8E80,
  747.                                          $8680,$7F00,$7800,$7160 );
  748.   VAR
  749.     i, j, k, n, o : WORD;
  750.   BEGIN
  751.     IF v = 0 THEN EXIT;
  752.  
  753.     j := $6FA;
  754.     o := 0;
  755.     WHILE v < ((j+1) SHR 1) DO
  756.       BEGIN
  757.         j := j SHR 1;
  758.         INC(o);
  759.       END;
  760.  
  761.     k := 10000;
  762.     FOR j := 0 TO 11 DO
  763.       IF (v SHL (5+o)) >= NoteTable[j] THEN
  764.         BEGIN
  765.           IF k > (v SHL (5+o)) - NoteTable[j] THEN
  766.             BEGIN
  767.               k := (v SHL (5+o)) - NoteTable[j];
  768.               n := j;
  769.             END;
  770.         END
  771.       ELSE
  772.         BEGIN
  773.           IF k > NoteTable[j] - (v SHL (5+o)) THEN
  774.             BEGIN
  775.               k := NoteTable[j] - (v SHL (5+o));
  776.               n := j;
  777.             END;
  778.         END;
  779.  
  780.     v := ((NoteTable[n] SHR (o+2))+1) SHR 1;
  781.   END;
  782.  
  783.  
  784.  
  785.  
  786.  
  787. {----------------------------------------------------------------------------}
  788. {                                                                            }
  789. { PROCEDIMIENTO: ProcessNewNote                                              }
  790. {                                                                            }
  791. { Calcula y procesa la siguiente nota de la partitura.                       }
  792. {                                                                            }
  793. { ENTRADAS: Ninguna.                                                         }
  794. {                                                                            }
  795. { SALIDAS:  Ninguna.                                                         }
  796. {                                                                            }
  797. {............................................................................}
  798.  
  799. PROCEDURE ProcessNewNote(VAR Song: TSong);
  800.   CONST
  801.     i    : WORD        = 0;
  802.     j    : WORD        = 0;
  803.     n    : TFullNote   = (Instrument:0);
  804.     can  : ^TCanal     = NIL;
  805.     Patt : PPattern    = NIL;
  806.     NewSample : BOOLEAN = FALSE;
  807.   BEGIN
  808.  
  809. {    SetBorder($FF, 0, 0);}
  810.  
  811.     i := (NoteHd + 1) AND (NoteBuffSize - 1);
  812.     NoteProcessed := @NoteBuff[i];
  813.     MyMove(NoteBuff[NoteHd], NoteProcessed^, SIZEOF(NoteBuff[0]));
  814.     NoteHd := i;
  815.     WITH NoteProcessed^ DO BEGIN
  816.  
  817.       REPEAT
  818.         EoMod       := NextNote = $FFFF;
  819.  
  820.         IF EoMod THEN
  821.           IF MyLoopMod THEN BEGIN
  822.             NextSeq := MyRepStart;
  823.  
  824.             IF NextSeq < MyFirstPattern THEN
  825.               NextSeq := MyFirstPattern;
  826.  
  827.             NextNote  := 1;
  828.             EoMod     := FALSE;
  829.           END ELSE BEGIN
  830.             Playing   := FALSE;
  831.             EXIT;
  832.           END;
  833.  
  834.         NotePlaying := NextNote;
  835.         SeqPlaying  := NextSeq;
  836.         Volume      := UserVols;
  837.  
  838.         IF Song.GetPatternSequence(SeqPlaying) >= Song.Patterns.Count THEN
  839.           BEGIN
  840.             INC(NextSeq);
  841.             IF NextSeq > MySongLen THEN NextNote := $FFFF
  842.                                    ELSE NextNote := 1;
  843.           END;
  844.       UNTIL Song.GetPatternSequence(SeqPlaying) < Song.Patterns.Count;
  845.  
  846.  
  847.       Patt := Song.GetPatternSeq(SeqPlaying);
  848.  
  849.       IF NextNote < Patt^.Patt^.NNotes THEN
  850.         INC(NextNote)
  851.       ELSE BEGIN
  852.         INC(NextSeq);
  853.         IF NextSeq > MySongLen THEN NextNote := $FFFF
  854.                                ELSE NextNote := 1;
  855.       END;
  856.  
  857.       IF Song.GetPatternSequence(SeqPlaying)  = 0 THEN
  858.         BEGIN
  859.           FillChar(Canales, SIZEOF(Canales), 0);
  860.           ModCommands.Tempo        := Song.InitialTempo;
  861.           ModCommands.BPMIncrement := Song.InitialBPM;
  862.  
  863.           FOR i := 1 TO MaxChannels DO
  864.             WITH Canales[i] DO BEGIN
  865.               Note.Period     := 800;
  866.               Note.Instrument := 1;
  867.               Note.Command    := mcNone;
  868.               Period          := 800;
  869.             END;
  870.  
  871.           REPEAT
  872.             INC(SeqPlaying);
  873.             IF SeqPlaying > MySongLen THEN NextNote := $FFFF
  874.                                       ELSE NextNote := 2;
  875.           UNTIL (NextNote = $FFFF) OR (Song.GetPatternSequence(SeqPlaying) <> 0);
  876.  
  877.           NextSeq := SeqPlaying;
  878.         END;
  879.  
  880.       IF NotePlaying = 1 THEN
  881.         IF Song.GetPatternTempo(SeqPlaying) <> 0 THEN
  882.           ModCommands.Tempo := Song.GetPatternTempo(SeqPlaying)
  883.         ELSE IF Patt^.Patt^.Tempo <> 0 THEN
  884.           ModCommands.Tempo := Patt^.Patt^.Tempo;
  885.  
  886.       FOR j := 1 TO Song.NumChannels DO BEGIN
  887.  
  888.         can := @Canales[j];
  889.  
  890.         Song.GetNote(SeqPlaying, NotePlaying, j, n);
  891.  
  892.         ConvertPeriod(n.Period);
  893.  
  894.         MyMove(n, Note[j], SIZEOF(n));
  895.  
  896.         NewSample := FALSE;
  897.         IF ((n.Instrument <> 0)                     AND
  898.             (can^.Note.Instrument <> n.Instrument)) OR
  899.            ((0 <> n.Period)                         AND
  900.             (n.Command <> mcNPortamento)            AND
  901.             (n.Command <> mcT_VSlide))             THEN
  902.           BEGIN
  903.             IF n.Instrument <> 0 THEN
  904.               BEGIN
  905.                 can^.Note.Instrument := n.Instrument;
  906.                 can^.Instrument      := PInstrument(Song.GetInstrument(n.Instrument))^.Instr;
  907.               END;
  908.  
  909.             SetNewSample(j, RawChannels[j], can^.Instrument, 0);
  910.             NewSample := TRUE;
  911.           END;
  912.  
  913.         IF (n.Instrument <> 0) AND (can^.Instrument <> NIL) THEN
  914.           can^.Volume := can^.Instrument^.Vol;
  915.  
  916.         IF n.Volume <> 0 THEN
  917.           can^.Volume := n.Volume - 1;
  918.  
  919.         IF can^.Volume > 64 THEN can^.Volume := 64;
  920.  
  921.         CommandStart(Song, can^, n);
  922.  
  923.         IF NewSample AND can^.SOffs THEN
  924.           SetNewSample(j, RawChannels[j], can^.Instrument, can^.SOffsVal);
  925.  
  926.         NoteProcessed^.Tempo := ModCommands.Tempo;
  927.  
  928.       END;
  929.  
  930.       MuestrasPerTick := ActualHz DIV TicksPerSecond;
  931.  
  932.       IF MuestrasPerTick > MaxSplPerTick THEN
  933.         MuestrasPerTick := MaxSplPerTick;
  934.  
  935.       NMuestras       := MuestrasPerTick * Tempo;
  936.       NoteHz          := ActualHz;
  937.       IF NoteHz = 0 THEN NoteHz := 1;
  938. {      NoteCalcVal     := ((65536*13900) DIV NoteHz) SHL 8;}
  939.       NoteCalcVal     := ((LONGINT(13900) SHL 12) DIV NoteHz) SHL 11;
  940.     END;
  941.  
  942.     NoteTl    := NoteHd;
  943.     NoteSound := NoteProcessed;
  944.  
  945. {    SetBorder(0, 0, 0);}
  946.  
  947.   END;
  948.  
  949.  
  950.  
  951.  
  952. PROCEDURE FillChannels(VAR Song: TSong);
  953.   CONST
  954.     FirstTick : BOOLEAN       = TRUE;
  955.     i         : WORD          = 0;
  956.     p         : ^TModRawChan  = NIL;
  957.     q         : POINTER       = NIL;
  958.     Buf       : PSampleBuffer = NIL;
  959.   BEGIN
  960.  
  961. {    SetBorder($FF, $FF, $FF);}
  962.  
  963.     Buf := @Buffers[BuffIdx];
  964.  
  965.     DelaySamples := Buf^.InUse;
  966.     IF DelaySamples THEN
  967.       BEGIN
  968.         EXIT;
  969.       END;
  970.  
  971.  
  972.     FOR i := 1 TO Song.NumChannels DO BEGIN
  973.       p := @RawChannels[i];
  974.       q := Addr(Buf^.IData^[i-1]);
  975.  
  976.       UnCanal(p^, q);
  977.  
  978. {
  979.       ASM
  980.         PUSH    BP
  981.         PUSH    DI
  982.         PUSH    SI
  983.         PUSH    ES
  984.         MOV     CX,MuestrasPerTick
  985.         MOV     BX,WORD PTR p
  986.         LES     DI,q
  987.         CALL    UnCanal
  988.         POP     ES
  989.         POP     SI
  990.         POP     DI
  991.         POP     BP
  992.       END;
  993. }
  994.       SplBuf[i] := FilterChunkWord(q^, MuestrasPerTick, Song.NumChannels, FilterVal, SplBuf[i]);
  995.     END;
  996.  
  997.     Buf^.InUse    := TRUE;
  998.     Buf^.NSamples := MuestrasPerTick;
  999.     Buf^.RateHz   := NoteHz;
  1000.     Buf^.DataType := dtInteger;
  1001.     Buf^.Channels := Song.NumChannels;
  1002.  
  1003.     INC(BuffIdx);
  1004.     IF BuffIdx > NumBuffers THEN BuffIdx := 1;
  1005.  
  1006. {    SetBorder($FF, 0, 0);}
  1007.  
  1008.   END; { PROCEDURE FillChannels }
  1009.  
  1010. {----------------------------------------------------------------------------}
  1011. {                                                                            }
  1012. { PROCEDIMIENTO: ProcessTick                                                 }
  1013. {                                                                            }
  1014. { Procesa un tick de la música. Normalmente, se usan 50 ticks por segundo,   }
  1015. { pero puede cambiarse.                                                      }
  1016. {                                                                            }
  1017. { ENTRADAS: Ninguna.                                                         }
  1018. {                                                                            }
  1019. { SALIDAS:  Ninguna.                                                         }
  1020. {                                                                            }
  1021. {............................................................................}
  1022.  
  1023. PROCEDURE ProcessTick(VAR Song: TSong);
  1024.   CONST
  1025.     SOTCanal = SIZEOF(TCanal);
  1026.     incr     : INTEGER     = 0;
  1027.     OTempoCt : WORD        = 0;
  1028.     Can      : PCanal      = NIL;
  1029.     Raw      : PModRawChan = NIL;
  1030.     NoteHzFreq : LONGINT   = 0;
  1031.     i        : WORD        = 0;
  1032.     j        : WORD        = 0;
  1033.     t        : WORD        = 0;
  1034.     step     : LONGINT     = 0;
  1035.     FBCount  : WORD        = 0;
  1036.     NumChannels : BYTE     = 0;
  1037.   VAR
  1038.     ScrTrace : WORD ABSOLUTE $B800:20;
  1039.   LABEL
  1040.     Fin;
  1041.   BEGIN 
  1042.  
  1043.     IF DelaySamples AND NOT UsingGUS THEN BEGIN
  1044.       FillChannels(Song);
  1045.  
  1046.       IF DelaySamples THEN GOTO Fin;
  1047.     END;
  1048.  
  1049.     INC(TickCount);
  1050.  
  1051.     NumChannels := Song.NumChannels;
  1052.  
  1053.     OTempoCt := TempoCt;
  1054.     INC(BPMCount, BPMIncrement);
  1055.     INC(TempoCt, BPMCount DIV BPMDivider);
  1056.     IF TempoCt <> OTempoCt THEN
  1057.       BPMCount := BPMCount MOD BPMDivider;
  1058.  
  1059.     i := TempoCt - OTempoCt;
  1060.     TempoCt := OTempoCt;
  1061.     FOR t := i DOWNTO 1 DO
  1062.       BEGIN
  1063.         INC(TempoCt);
  1064.  
  1065.         IF TempoCt >= NoteProcessed^.Tempo THEN BEGIN
  1066.           ProcessNewNote(Song);
  1067.  
  1068.           IF NOT Playing THEN GOTO Fin;
  1069.           TempoCt := 0;
  1070.         END;
  1071.  
  1072.         IF (TempoCt > 0) OR Song.FirstTick THEN
  1073.           ASM
  1074.                     XOR     CH,CH
  1075.                     MOV     CL,[NumChannels]
  1076.     @@lp:            PUSH   CX
  1077.                      MOV    AL,CL
  1078.                      DEC    AL
  1079.                      MOV    BL,SOTCanal
  1080.                      MUL    BL
  1081.                      MOV    SI,OFFSET Canales
  1082.                      ADD    SI,AX
  1083.                      MOV    BL,TCanal([SI]).Note.Command
  1084.                      ADD    BL,BL
  1085.                      XOR    BH,BH
  1086.                      CALL   DoTickCommand
  1087.                      POP    CX
  1088.                      LOOP   @@lp
  1089.           END;
  1090.  
  1091.       END;
  1092.  
  1093.     IF NOT MyCanFallBack THEN
  1094.       PleaseFallBack := 0;
  1095.  
  1096.     IF PleaseFallBack > 0 THEN BEGIN
  1097.       PleaseFallBack := 0;
  1098.       i := ActualHz;
  1099.       WHILE (i = ActualHz) AND (i <> ActiveDevice^.GetRealFreqProc(0)) DO
  1100.         BEGIN
  1101.           DEC(DesiredHz, 100);
  1102.           i := ActiveDevice^.GetRealFreqProc(DesiredHz);
  1103.         END;
  1104.       ChangeSamplingRate(DesiredHz);
  1105.     END;
  1106.  
  1107.     FOR i := 1 TO Song.NumChannels DO
  1108.       BEGIN
  1109.         SetBorder(63, 0, 63);
  1110.  
  1111.         Can := @Canales[i];
  1112.         Raw := @RawChannels[i];
  1113.  
  1114.         IF NOT UsingGUS THEN
  1115.           Raw^.Volume := (Can^.Volume*WORD(UserVols[i]) SHR 4) DIV
  1116.                          ((Song.NumChannels + 1) AND $FFFE)
  1117.         ELSE
  1118.           Raw^.Volume := (((Can^.Volume*WORD(UserVols[i])) SHR 6) + 1) SHR 1;
  1119.  
  1120.         IF Raw^.Volume >= $80 THEN Raw^.Volume := $7F;
  1121.  
  1122.         IF Can^.Period > $7FFF THEN Can^.Period := $7FFF;
  1123.  
  1124.         IF Can^.Instrument <> NIL THEN
  1125.           ASM
  1126.                 LES     SI,[Can]
  1127.                 MOV     AX,TCanal([ES:SI]).Period
  1128.                 LES     SI,TCanal([ES:SI]).Instrument
  1129.                 MOV     DX,TInstrumentRec([ES:SI]).NAdj
  1130.                 MUL     DX
  1131.                 MOV     BX,TInstrumentRec([ES:SI]).DAdj
  1132.                 DIV     BX
  1133.  
  1134.                 LES     SI,[Can]
  1135.                 MOV     TCanal([ES:SI]).RealPeriod,AX
  1136.           END
  1137.         ELSE
  1138.           BEGIN
  1139.             Can^.RealPeriod := Can^.Period;
  1140.             Raw^.Volume     := 0;
  1141.             Raw^.Flags      := Raw^.Flags AND NOT rcfActiveChannel;
  1142.           END;
  1143.  
  1144.  
  1145.         IF      Can^.RealPeriod <   $7F THEN Can^.RealPeriod :=   $7F
  1146.         ELSE IF Can^.RealPeriod > $7FFF THEN Can^.RealPeriod := $7FFF;
  1147.  
  1148. IF NOT UsingGUS THEN
  1149.         ASM
  1150.  
  1151.                 MOV     AX,[WORD PTR NoteCalcVal]
  1152.                 MOV     DX,[WORD PTR NoteCalcVal+2]
  1153.                 LES     SI,[Can]
  1154.                 MOV     BX,TCanal([ES:SI]).RealPeriod
  1155.                 DIV     BX
  1156.                 ADD     DX,DX
  1157.                 CMP     DX,BX
  1158.                 JC      @@1
  1159.                  INC    AX
  1160.         @@1:
  1161.                 MOV     [WORD PTR step],AX
  1162.  
  1163.         END
  1164. ELSE
  1165.   step := $1000;
  1166.  
  1167.         Raw^.StepFrac := WORD(step SHL 4);
  1168.         Raw^.StepInt  := WORD(step SHR 12);
  1169.  
  1170.         IF FilterIsOn THEN FilterVal := FilterOn
  1171.                       ELSE FilterVal := FilterOff;
  1172.  
  1173.         IF Can^.doretrig AND (Can^.Instrument <> NIL) THEN
  1174.           SetNewSample(i, Raw^, Can^.Instrument, 0);
  1175.  
  1176.         IF NOT Permisos[i] THEN Raw^.Flags := Raw^.Flags AND NOT rcfActiveChannel
  1177.                            ELSE Raw^.Flags := Raw^.Flags OR      rcfActiveChannel;
  1178.  
  1179.         IF UsingGUS THEN
  1180.           IF Permisos[i] THEN
  1181.             ChangeVoiceParams(i-1, Raw^.Volume,
  1182.                                    (LONGINT(1024)*13900 + (Can^.RealPeriod SHR 1)) DIV Can^.RealPeriod,
  1183.                                    PlayingSong^.PanPositions[i])
  1184.           ELSE
  1185.             ChangeVoiceParams(i-1, 0,
  1186.                                    $FFFFFFFF, {(LONGINT(256)*13900) DIV Can^.RealPeriod,}
  1187.                                    PlayingSong^.PanPositions[i]);
  1188.  
  1189.         IF      Can^.Period <   $7F THEN Can^.Period :=   $7F
  1190.         ELSE IF Can^.Period > $7FFF THEN Can^.Period := $7FFF;
  1191.  
  1192.         SetBorder(0, 0, 0);
  1193.  
  1194.       END;
  1195.  
  1196.     IF NOT UsingGUS THEN
  1197.       FillChannels(Song);
  1198.  
  1199. Fin:
  1200.   END;
  1201.  
  1202. {----------------------------------------------------------------------------}
  1203. {                                                                            }
  1204. { PROCEDIMIENTO: ProcessTickEntry                                            }
  1205. {                                                                            }
  1206. { Entrada desde ensamblador de ProcessTick.                                  }
  1207. {                                                                            }
  1208. { ENTRADAS: Ninguna.                                                         }
  1209. {                                                                            }
  1210. { SALIDAS:  Ninguna.                                                         }
  1211. {                                                                            }
  1212. {............................................................................}
  1213.  
  1214. PROCEDURE ProcessTickEntry;
  1215.   CONST
  1216.     Semaphor : BYTE        = 0;
  1217.     _SS      : WORD        = 0;
  1218.     _SP      : WORD        = 0;
  1219.     SaveFlags: WORD        = 0;
  1220.   VAR
  1221.     ScrInc : WORD ABSOLUTE $B800:180;
  1222.   LABEL
  1223.     Fin1, Fin2;
  1224.   BEGIN
  1225.     IF DontExecute THEN EXIT;
  1226.  
  1227. {  INC(ScrInc);}
  1228.  
  1229. {
  1230.     ASM
  1231.         PUSHF
  1232.         POP     AX
  1233.         MOV     [SaveFlags],AX
  1234.         STI
  1235.     END;
  1236. }
  1237.  
  1238.     IF NOT Playing THEN
  1239.       BEGIN
  1240.         TempoCT := 1;
  1241.         GOTO Fin1;
  1242.       END;
  1243.  
  1244.     IF Semaphor <> 0 THEN
  1245.       GOTO Fin2;
  1246.  
  1247.     INC(Semaphor);
  1248.  
  1249.     ASM
  1250.         MOV     [_SS],SS
  1251.         MOV     [_SP],SP
  1252.         MOV     AX,DS
  1253.         MOV     SS,AX
  1254.         MOV     SP,OFFSET PlayModStack + PlayModStackSize
  1255.     END;
  1256. {DirectWrite(0, HexWord(ActualHz));}
  1257.     ProcessTick(PlayingSong^);
  1258.  
  1259.     ASM
  1260.         MOV     SS,[_SS]
  1261.         MOV     SP,[_SP]
  1262.     END;
  1263.  
  1264.     DEC(Semaphor);
  1265.  
  1266. Fin1:
  1267.  
  1268.     IF ModTickProcValid THEN 
  1269.       ModTickProc(PlayingSong^, TempoCt = 0);
  1270.  
  1271. Fin2:
  1272. {
  1273.     ASM
  1274.         MOV     AX,[SaveFlags]
  1275.         PUSH    AX
  1276.         POPF
  1277.     END;
  1278. }
  1279.  
  1280.   END;
  1281.  
  1282.  
  1283.  
  1284.  
  1285. FUNCTION IdleGiver : PSampleBuffer; FAR;
  1286.   BEGIN
  1287.     IdleGiver := NIL;
  1288.   END;
  1289.  
  1290.  
  1291. FUNCTION BufferGiver : PSampleBuffer; FAR;
  1292.   BEGIN
  1293.     BufferGiver := NIL;
  1294.     IF NOT Buffers[BuffGive].InUse THEN EXIT;
  1295.     BufferGiver := @Buffers[BuffGive];
  1296.     INC(BuffGive);
  1297.     IF BuffGive > NumBuffers THEN BuffGive := 1;
  1298.   END;
  1299.  
  1300.  
  1301.  
  1302.  
  1303. PROCEDURE FillWithSamples(VAR Buff; Size: WORD);
  1304.   CONST
  1305.     mBuff : PIntBuff = NIL;
  1306.   BEGIN
  1307. ;EXIT;
  1308.     mBuff := DMABufferPtr;
  1309.     IF Stereo THEN
  1310.       BEGIN
  1311.         IF DMABufferEnd - WORD(mBuff) < Size*2 THEN
  1312.           mBuff := DMABuffer;
  1313.  
  1314.         ASM
  1315.                 PUSH    DS
  1316.  
  1317.                 CLD
  1318.                 LES     DI,[Buff]
  1319.                 MOV     CX,[Size]
  1320.                 LDS     SI,[mBuff]
  1321.  
  1322.         @@lp1:
  1323.                 LODSB
  1324.                 XCHG    AL,AH
  1325.                 LODSB
  1326.                 XOR     AX,$8080
  1327.                 ADD     AH,AL
  1328.                 MOV     AL,0
  1329.                 ROR     AX,1
  1330.                 STOSW
  1331.                 LOOP    @@lp1
  1332.  
  1333.                 POP     DS
  1334.  
  1335.         END;
  1336.  
  1337.       END
  1338.     ELSE
  1339.       BEGIN
  1340.         IF DMABufferEnd - WORD(mBuff) < Size THEN
  1341.           mBuff := DMABuffer;
  1342.  
  1343.         ASM
  1344.                 PUSH    DS
  1345.  
  1346.                 CLD
  1347.                 LES     DI,[Buff]
  1348.                 MOV     CX,[Size]
  1349.                 LDS     SI,[mBuff]
  1350.  
  1351.         @@lp2:
  1352.                 LODSB
  1353.                 XOR     AL,$80
  1354.                 XCHG    AL,AH
  1355.                 XOR     AL,AL
  1356.                 STOSW
  1357.                 LOOP    @@lp2
  1358.  
  1359.                 POP     DS
  1360.  
  1361.         END;
  1362.  
  1363.       END;
  1364.  
  1365.   END;
  1366.  
  1367.  
  1368.  
  1369.  
  1370. PROCEDURE PlayStart(VAR Song: TSong);
  1371.   VAR
  1372.     i, j : WORD;
  1373.   BEGIN
  1374.  
  1375.     ASM CLI END;
  1376.  
  1377.     PlayingSong := @Song;
  1378.  
  1379.     MyFirstPattern := FirstPattern;
  1380.     MyRepStart     := RepStart;
  1381.     MySongLen      := SongLen;
  1382.  
  1383.     IF MySongLen = 0 THEN MySongLen := Song.SequenceLength;
  1384.  
  1385.     IF MyFirstPattern = 0 THEN NextSeq := 1
  1386.                           ELSE NextSeq := MyFirstPattern;
  1387.  
  1388.     IF NextSeq > MySongLen THEN
  1389.       BEGIN
  1390.         ASM STI END;
  1391.         EXIT;
  1392.       END;
  1393.  
  1394.     IF (MyRepStart              =  0)         AND
  1395.        (Song.SequenceRepStart   <= MySongLen) AND
  1396.        (Song.SequenceRepStart   <> 0)         THEN
  1397.       MyRepStart    := Song.SequenceRepStart;
  1398.  
  1399.     MyLoopMod       := (TRUE{LoopMod} AND (MyRepStart <> 0)) OR ForceLoopMod;
  1400.     TempoCt         := 254;
  1401.     Tempo           := Song.InitialTempo;
  1402.     BPMIncrement    := Song.InitialBPM;
  1403.     TickCount       := 0;
  1404.     NextNote        := 1;
  1405.     DelaySamples    := FALSE;
  1406.     MuestrasPerTick := 1;
  1407.     MaxSplPerTick   := MaxOutputFreq DIV TicksPerSecond;
  1408.  
  1409.     IF MyRepStart < NextSeq THEN MyRepStart := NextSeq;
  1410.  
  1411.     WITH NoteBuff[0] DO BEGIN
  1412.       EoMod       := FALSE;
  1413.       Tempo       := 6;
  1414.       NotePlaying := 0;
  1415.       SeqPlaying  := 0;
  1416.       Volume      := UserVols;
  1417.       NMuestras   := 0;
  1418.     END;
  1419.  
  1420.     NoteHd        := 0;
  1421.     NoteTl        := 0;
  1422.     NoteSound     := @NoteBuff[0];
  1423.     NoteProcessed := @NoteBuff[0];
  1424.  
  1425.     FillChar(Canales, SIZEOF(Canales), 0);
  1426.  
  1427.     FOR i := 1 TO MaxChannels DO
  1428.       WITH Canales[i] DO BEGIN
  1429.         Note.Period     := 800;
  1430.         Note.Instrument := 1;
  1431.         Note.Command    := mcNone;
  1432.         Period          := 800;
  1433.       END;
  1434.  
  1435.     SizeOfABuffer := MaxSplPerTick*MaxChannels*2;
  1436.     FillChar(Buffers, SIZEOF(Buffers),  0);
  1437.     IF NOT UsingGUS THEN
  1438.       FOR i := 1 TO NumBuffers DO
  1439.         BEGIN
  1440.           FullHeap.HGetMem(POINTER(Buffers[i].IData), SizeOfABuffer);
  1441.           IF Buffers[i].IData = NIL THEN
  1442.             BEGIN
  1443.               Song.Status := msOutOfMemory;
  1444.               PlayStop;
  1445.               ASM STI END;
  1446.               EXIT;
  1447.             END;
  1448.           FillChar(Buffers[i].IData^, SizeOfABuffer,  $7F);
  1449.         END;
  1450.     BuffIdx  := 1;
  1451.     BuffGive := 1;
  1452.  
  1453.     FillChar(RawChannels, SIZEOF(RawChannels), 0);
  1454.  
  1455.     ChangeSamplingRate(DesiredHz);
  1456.  
  1457.     ASM STI END;
  1458.  
  1459.     SetBufferAsker(IdleGiver);
  1460.  
  1461.     IF UsingGUS THEN
  1462.       DontExecute := TRUE;
  1463.  
  1464.     MyCanFallBack  := FALSE;
  1465.     Playing        := TRUE;
  1466.  
  1467.     IF NOT UsingGUS THEN
  1468.       FOR i := 1 TO NumBuffers DO
  1469.         ProcessTickEntry;
  1470.  
  1471.     IF UsingGUS THEN
  1472.       SetGusChannels(Song.NumChannels);
  1473.  
  1474.     StartSampling;
  1475.     ChangeSamplingRate(DesiredHz);
  1476.  
  1477.     DontExecute := FALSE;
  1478.  
  1479.     SetBufferAsker(BufferGiver);
  1480. {
  1481.     WHILE DeviceIdling AND (NOT KbdKeyPressed) DO;
  1482. }
  1483.     PleaseFallBack := 0;
  1484.     MyCanFallBack  := CanFallBack;
  1485.   END;
  1486.  
  1487.  
  1488.  
  1489.  
  1490. PROCEDURE ChangeSamplingRate(Hz: WORD);
  1491.   VAR
  1492.     MyHz : WORD;
  1493.   LABEL
  1494.     Otra;
  1495.   BEGIN
  1496. Otra:
  1497.     DesiredHz := Hz;
  1498.     MyHz      := ActiveDevice^.GetRealFreqProc(Hz);
  1499.  
  1500.     IF MyHz >  MaxSplPerTick * TicksPerSecond THEN
  1501.       BEGIN
  1502.         DEC(Hz, 100);
  1503.         GOTO Otra;
  1504.       END;
  1505.  
  1506.     IF MyHz < 1000 THEN
  1507.       BEGIN
  1508.         INC(Hz, 100);
  1509.         GOTO Otra;
  1510.       END;
  1511.  
  1512.     IF MyHz <> ActualHz THEN
  1513.       BEGIN
  1514.         ActualHz := MyHz;
  1515.         SetPeriodicProc(ProcessTickEntry, TicksPerSecond * 3 DIV 2{8} {DIV 3});
  1516.       END;
  1517.  
  1518.   END;
  1519.  
  1520.  
  1521.  
  1522.  
  1523. PROCEDURE PlayStop;
  1524.   VAR
  1525.     i  : WORD;
  1526.     ug : BOOLEAN;
  1527.   BEGIN
  1528.     Playing := FALSE;
  1529.  
  1530.     SetBufferAsker(IdleGiver);
  1531.  
  1532. {
  1533.     WHILE (NOT DeviceIdling) AND (NOT KbdKeyPressed) DO;
  1534. }
  1535.  
  1536.     ug := UsingGUS;
  1537.  
  1538.     EndSampling;
  1539.  
  1540.     IF NOT ug THEN
  1541.       FOR i := 1 TO NumBuffers DO
  1542.         FullHeap.HFreeMem(POINTER(Buffers[i].IData), SizeOfABuffer);
  1543.  
  1544.   END;
  1545.  
  1546.  
  1547.  
  1548.  
  1549. BEGIN
  1550.   Playing        := FALSE;
  1551.   LoopMod        := FALSE;
  1552.   ActualHz       := 0;
  1553.  
  1554.   IF FilterIsOn THEN FilterVal := FilterOn
  1555.                 ELSE FilterVal := FilterOff;
  1556.  
  1557.   FillChar(UserVols, SIZEOF(UserVols), 255);
  1558.   FillChar(Permisos, SIZEOF(Permisos), TRUE);
  1559.   FillChar(SplBuf,   SIZEOF(SplBuf),      0);
  1560. END.
  1561.